QUANTIFYING VISUALIZATION VIBES REPRODUCIBLE ANALYSIS
ANONYMIZED
2025-04-01
In the QUANTIFYING VISUALIZATION VIBES project studies, participants completed an attribution eliciation survey, asking questions about their social inferences drawn from (5) stimulus images (data visualizations). Each participant was randomly assigned to one of 6 stimulus blocks, each containing 1 image from each of (4) ‘embellishment categories’ (ranging from most abstract to most figural). Each participant started by responding to questions for a single ‘common’ stimulus (B0-0). Two participant recruitment pools were used: Tumblr (to replicate and compare survey results to the interview study conducted by Morgenstern, Fox, Jones & Satyanarayan (under review)) and a broader demographic sample recruited via Prolific.
This notebook contains code to replicate quantitative analysis of data reported in VIS submission #1006.
SETUP
Import Packages
knitr::opts_chunk$set(echo = TRUE)
#UTILITIES
library(Hmisc) # %nin% operator
library(psych) #describe()
library(tidyverse) #all the things
library(magrittr) #special pipes like %<>%
library(summarytools) #data quality
library(lubridate) #dealing with dates
library(tinytable) ##sparkline tables
library(webshot2) ##saving sparkline tables
#EDA
library(qacBase)
#VIZ
library(ggformula) #regression syntax viz
library(ggstatsplot) #dummies
library(gghalves) #half boxplots
library(GGally) #extends ggplot for EDA
library(corrplot) #sophisticated correlation plots
library(ggeasy) #easy labelling
library(ggh4x) #guides [dual axes]
library(patchwork) #multi-plot layout
library(ggdist) #raincloud plots and other distributionals
library(viridis) #color palettes
library(RColorBrewer) #color palettes
library(plotly) # interactive graphs
library(paletteer) #more palettes
library(interactions) ##easier regression ixn plots.srlsy
library(tidygraph)
library(ggsankey) ## sankey plots for study 3 categorical change
#MODELLING
library(jtools) #Social Science regression utilities
library(easystats) #modelling helpers
library(see)
library(sjPlot)
library(lme4)
library(lmerTest) #for CIs in glmer
# library(mixed) ## utilities for glmers
library(jmv) ## jamovi EFA
#STATISTICAL TESTS
library(kSamples) #AD K-SAMPLE TEST (for distribution comparison)
library(rstatix) #FRIEDMAN'S TESTS and effect sizes
#CONFIG
options(readr.show_col_types = FALSE) #don't show coltypes on read_csv
n_blocks = 6
## IMPORTANT
GRAPH_SAVE = FALSE #set to true to generate all the SD graphs and save to folders (note this will overwrite existing graphs)
source("graphing_functions.R") #import graphing palettes and custom functionsImport References
############## IMPORT REFERENCE FILES
ref_stimuli <- readRDS("data/reference/ref_stimuli.rds")
ref_labels <- readRDS("data/reference/ref_labels.rds")
############## SETUP Graph Labels
ref_labels_min <- readRDS("data/REFERENCE/ref_labels_S3.rds")
ref_stim_id <- levels(ref_stimuli$ID)
ref_cat_questions <- c("MAKER_ID","MAKER_AGE","MAKER_GENDER")
ref_free_response <- c("MAKER_DETAIL", "MAKER_EXPLAIN", "TOOL_DETAIL", "CHART_EXPLAIN")
ref_conf_questions <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", "TOOL_CONF")
ref_sd_questions <- rownames(ref_labels)
# ref_blocks <- c("block1", "block2", "block3", "block4", "block5", "block6")
ref_blocks <- c(1,2,3,4,5,6)
############## MINIMAL QUESTION SET FOR Study 3
ref_min_sd_questions <- c("DESIGN","DATA","POLITICS", "TRUST","ALIGN","BEAUTY","INTENT")
ref_min_sd_questions_z <- c("DESIGN_z","DATA_z","POLITICS_z", "TRUST_z","ALIGN_z","BEAUTY_z","INTENT_z")
ref_min_conf_questions <- c("ID_CONF","AGE_CONF","GENDER_CONF")
ref_min_cat_questions <- c("ID","AGE","GENDER","ENCOUNTER")
# ref_min_free_questions <- c("EXPLAIN")Import Data
############## IMPORT COMBINED DATA FILES
df_participants_all <- readRDS("data/input/df_participants_ALL.rds") #1 row per participant — demographic
df_graphs_all <- readRDS("data/input/df_graphs_ALL.rds") #1 row per participantXgraph (i.e. a trial)
df_sd_questions_long_all <- readRDS("data/input/df_sd_questions_long_ALL.rds") #1 row per participantXgraphXSD question (i.e. a question on one trial)
############## STUDY 1 & 2 DATA FILES
df_graphs <- readRDS("data/input/df_graphs.rds") #only categorical and numeric questions
df_sd_questions_long_z <- readRDS("data/input/df_sd_questions_long_z.rds") # only sd questions LONG, zscored
############## IMPORT Study 3 DATA FILES
df_graphs_s3 <- readRDS("data/input/df_graphs_s3.rds") #only categorical and numeric questions from Study 3
df_questions_s3 <- readRDS("data/input/df_questions_S3.rds")METHODS
(3.2) Participants
df <- df_participants_all
## FOR DESCRIPTIVES PARAGRAPH
# STUDY 1
df1 <- df %>% filter(Study == "Study1")
desc.gender.1 <- table(df1$D_gender) %>% prop.table()
names(desc.gender.1) <- levels(df1$D_gender)
participants_s1 <- nrow(df1)
# STUDY 2
df2 <- df %>% filter(Study == "Study2")
desc.gender.2 <- table(df2$D_gender) %>% prop.table()
names(desc.gender.2) <- levels(df2$D_gender)
participants_s2 <- nrow(df2)
# STUDY 3
df3 <- df %>% filter(Study == "Study3")
desc.gender.3 <- table(df3$D_gender) %>% prop.table()
names(desc.gender.3) <- levels(df3$D_gender)
participants_s3 <- nrow(df3)As Reported in Section 3.2 Participants :
78 US-Based English-speaking individuals users of the social media platform TUMBLR participated in Study 1, ( 36% Female, 5% Male, 40% Non-binary, 3 % Prefer Not to Say, 17% Prefer to Self Describe).
240 US-Based English-speaking individuals were recruited from Prolific to participate in Study 2, ( 54% Female, 42% Male, 3% Non-binary, 0.4% Prefer to Self Describe, 0% Prefer Not to Say. Other).
40 US-Based English-speaking individuals were recruited from Prolific to participate in Study 3, ( 50% Female, 47.5% Male, 2.5% Non-binary, 0% Prefer to Self Describe, 0% Prefer Not to Say. Other).
rm(df, df1, desc.gender.1, participants_s1, df2, desc.gender.2, participants_s2, df3, desc.gender.3, participants_s3)(3.3) Survey Response Time
df <- df_participants_all
## for descriptives paragraph
s12.desc.duration <- psych::describe(df %>% filter(Study %in% c("Study1","Study2")) %>% pull(duration.min))
s3.desc.duration <- psych::describe(df %>% filter(Study == "Study3") %>% pull(duration.min))As Reported in Section 3.3 Procedure :
In studies 1 and 2, responses ranged from 11 to 228 minutes, with a mean response time of 45 minutes, SD = 26.
In study 3, responses ranged from 13 to 110 minutes, with a mean response time of 41 minutes, SD = 20.
rm(df, s12.desc.duration, s3.desc.duration)RESULTS
(4.1.2) Variance in Confidence
library(tinytable)
library(webshot2)
## SETUP LIST OF NUMERIC DATAFRAMES
all_q <- c(ref_min_conf_questions)
## DECIDE DATAFRAME VERSION (Raw, minimal questions)
df <- df_graphs_all %>%
filter(
#filter for only block 1 data
Assigned.Block==1,
#drop pilot data
Study != "Study0"
) %>%
#drop z-score cols
select(-contains("_z"), -contains("_politics")) %>%
#only include studies 1 and 2
filter(Study !="Study3") %>%
droplevels()
## SANITY CHECK INCLUDED DATA
# addmargins(table(df$Study, df$Assigned.Block)/5)
## SETUP NUMERIC DATAFRAME
df_num <- df %>% select(all_of(all_q))
############ POPULATE LIST OF FILTERED DATAFRAMES NUMERIC QUESTIONS
d_q <- c(ref_min_conf_questions)
stimuli <- as.vector(levels(df$STIMULUS))
# Define row and column names
col_names <- d_q
row_names <- stimuli
# Initialize an empty list to store the structure
m <- list() ## MINIMAL LIST OF JUST NUMERIC VALUS
f <- list() ## DATAFRAME WITH STUDY AND SAMPLE
# Loop over row names
for (s in row_names) { #ROWS ARE QUESTIONS
# Initialize an empty list for each row
m[[s]] <- list()
f[[s]] <- list()
# Loop over column names
for (q in col_names) { #COLS ARE STIMULI
# Create a small dataframe for demonstration
# m[[r]][[c]] <- data.frame(Value = sample(1:10, 5, replace = TRUE))
m[[s]][[q]] <- df %>% filter(STIMULUS==s) %>% select(q) %>% pull()
f[[s]][[q]] <- df %>% filter(STIMULUS==s) %>% select(Study,q)
}
}
################################################
####### WORKS WITH NUMBER ONLY DATAFRAME passed through data =
# CUSTOM DENSITY PLOT
dist <- function(d, ...){
d <- as.data.frame(d)
ggplot(d,aes(x = d )) +
geom_density(alpha=0.5, fill="black") +
theme_void()
}
###########################################################
##density faceted by color
custom_plot <- function(x, question_name, full_data,...) {
# 'x' is a vector (extracted column) — useless
# 'full_data' is the original list of dataframes
## CONSTRUCT DATAFRAME
vf <- full_data[[question_name]]
# browser()
ggplot(vf, aes(x = vf[[2]], fill = Study)) +
geom_density(alpha=0.5) +
scale_fill_manual(values = my_palettes(name="simple_studies", direction = "1")) +
scale_color_manual(values = my_palettes(name="simple_studies", direction = "1")) +
theme_void() + easy_remove_legend()
}
###########################################################
###########################################################
make_row_tracking_fun <- function(rows, full_data, tab) {
counter <- 0
function(x, ...) {
counter <<- counter + 1
current_index <- rows[counter]
question_name <- tab$VARIABLE[current_index]
custom_plot(
x = x,
# row_index = current_index,
full_data = full_data,
question_name = question_name,
...
)
}
}
#### SETUP TABLE
tab <- data.frame(
VARIABLE = all_q,
LABEL = c("Maker Confidence", "Age Confidence","Gender Confidence"),
AGGREGATE = "",
B1_A="",
B1_B="",
B1_C="",
B1_D="",
B0_D=""
# STATISTICS = c(stat_id, stat_age, stat_gender, stat_encounter,stat)
# STATISTICS = c(stat_id, stat_age, stat_gender, stat_tools, stat_encounter, stat_action2, stat_action4, stat)
# c("","","","","","","",stat)
)
##hacky workaround for plot_tt not passing row number to function
row_counter <- 0
rows <- 1:3
############## TINY TABLE
### themes: bootstrap, grid, spacing
t <- tinytable::tt(tab, theme = "bootstrap") %>%
## PLOT AGGREGATE PLOTS IN COLUMN 2
plot_tt(j=3, i= rows, fun=dist, data = df_num, color="black") %>%
## PLOT B1_A IN COLUMN 3
plot_tt(j=4, i=rows, fun = make_row_tracking_fun(rows, f[["B1-1"]],tab), data = f[["B1-1"]]) %>%
plot_tt(height=1,j=5, i=rows, fun = make_row_tracking_fun(rows, f[["B1-2"]],tab), data = f[["B1-2"]]) %>%
plot_tt(height=1,j=6, i=rows, fun = make_row_tracking_fun(rows, f[["B1-3"]],tab), data = f[["B1-3"]]) %>%
plot_tt(height=1,j=7, i=rows, fun = make_row_tracking_fun(rows, f[["B1-4"]],tab), data = f[["B1-4"]]) %>%
plot_tt(height=1,j=8, i=rows, fun = make_row_tracking_fun(rows, f[["B0-0"]],tab), data = f[["B0-0"]])
## saved manually as png
# if(GRAPH_SAVE){
# # save_tt(t, output="figs/tables/sparklines.png", overwrite = TRUE) ## CAN'T SAVE, HAVE TO MANUALLY SAVE FROM VIEWER WINDOW
# save_tt(t, output="figs/tables/confidence_sparklines.tex", overwrite = TRUE)
# }
## TO RENDER TO VIEWER
print("note that object t can only be rendered to viewer in RStudio, not to Rmd notebook")## [1] "note that object t can only be rendered to viewer in RStudio, not to Rmd notebook"t| VARIABLE | LABEL | AGGREGATE | B1_A | B1_B | B1_C | B1_D | B0_D |
|---|---|---|---|---|---|---|---|
| ID_CONF | Maker Confidence |  |
 |
 |
 |
 |
 |
| AGE_CONF | Age Confidence |  |
 |
 |
 |
 |
 |
| GENDER_CONF | Gender Confidence |  |
 |
 |
 |
 |
 |
##CLEANUP
rm(tab,m,f,col_names, row_names, all_q, df, d_q, df_num, stimuli)(4.1.3) Variance in Identifications & Characterizations
Statistical Model
As reported in 4.3.1, here we test for significant effects in a model predicting response by QUESTION and STIMULUS (for Studies 1&2, Block 1) to verify that survey responses do indeed vary in response to each question and stimulus.
## SETUP DATA
df <- df_sd_questions_long_z %>%
filter(Study %in% c("Study1","Study2"))
# mutate(
# STIMULUS = factor(STIMULUS, levels=c("B0-0","B1-2","B1-1","B1-3","B1-4")),
# QUESTION = factor(QUESTION, levels = c("DESIGN","DATA","POLITICS","TRUST","ALIGN","INTENT","BEAUTY"))
# ) %>%
# droplevels()
## SANITY CHECK data in model
# table(df$Study, df$STIMULUS)
## MODEL question response by question and stimulus
m1 <- lmer(value ~ QUESTION * STIMULUS + (1|PID), data = df)
# summary(m1)
# anova(m1)
## MODEL question response by question and stimulus and study
m2 <- lmer(value ~ QUESTION * STIMULUS + Study + (1|PID), data = df)
# summary(m2)
anova(m2)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## QUESTION 89.78 8.9782 10 16900.8 10.8574 < 2.2e-16 ***
## STIMULUS 64.16 2.6731 24 3121.6 3.2326 1.88e-07 ***
## Study 1.72 1.7218 1 312.7 2.0822 0.15
## QUESTION:STIMULUS 2872.99 11.9708 240 16900.8 14.4763 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 compare_performance(m1,m2,rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## ------------------------------------------------------------------------
## m2 | lmerModLmerTest | 0.185 | 0.166 | 0.023 | 0.898 | 0.909
## m1 | lmerModLmerTest | 0.185 | 0.166 | 0.023 | 0.898 | 0.909
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## -------------------------------------------------------------------
## m2 | 0.514 | 0.506 | 0.021 | 62.50%
## m1 | 0.486 | 0.494 | 0.979 | 37.50%## USE EMMEANS TO GET MORE INTERPRETABLE COEFFICIENTS
# library(emmeans)
# contrast(emmeans(m2, ~ QUESTION * STIMULUS), method = "eff")
# contrast(emmeans(m2, ~ QUESTION), method = "eff")
# contrast(emmeans(m2, ~ STIMULUS), method = "eff")Note that analysis of variance for the model predicting (value) by an interaction between QUESTION and STIMULUS with linear fixed term Study indicates a significant interaction between QUESTION as STIMULUS (as expected), and a non-significant fixed effect of Study (indicating answers did not significantly vary between Study 1 and Study 2).
Significant main effect of question (\(F(10) = 11, p <0.001\))
Significant main effect of stimulus (\(F(24) = 3, p <0.001\))
Significant interaction of stimulus and question (\(F(240) =14.48, p < 0.001\)) (reported in paper)
Not significant main effect of study (\(F(1) = 2, p = 0.15\)) (reported in paper)
The following code blocks generate stimulus-level images for responses to short-form survey questions from Block 1.. Note that these images are manually combined in an vector-illustration program for annotation.
Semantic Differential Questions (Block 1)
This plots the short_form survey set of semantic differential questions for BLOCK 1 stimuli for Study 1,2,3 faceting by pre/post on study 3, visualized as a stacked ridgeplot (Note: these plots are written to the figs directory, not displayed inline)
#### DENSITY RIDGES#############################################################################
#### loop over questions and stimuli, vertically stack studies, color by sample
## DEFINE DF
df <- df_sd_questions_long_all%>%
#only block 1 for balanced data
filter(Assigned.Block==1) %>%
#drop pilot data
filter(Study != "Study0") %>%
#for Study 3 ONLY, set SAMPLE = TIME (for graphing purpose)
mutate(
Sample = case_when(Study =="Study3" ~ TIME ,
.default = Sample)) %>%
mutate(Sample = factor(Sample, levels = c("TUMBLR","GENERAL","POST","PRE"))) %>%
mutate(Study = factor(Study, levels=order_study)) %>%
droplevels()
## DEFINE REFS
n_q <- length(levels(df$QUESTION))
stimuli <- levels(df$STIMULUS)
questions <- ref_min_sd_questions #has qs in right order
labels <- ref_labels_min
## SET INITIAL VALUES
s <- stimuli[1]
q <- questions[1]
x = list() #list of plots
## LOOP OVER STIMULI, LOOP OVER QUESTIONS
for (s in stimuli){
i=0
# print(s)
for (q in questions) {
i = i+1
# print(i)
# print(q)
## FILTER Q AND CALCULATE MEDIAN
d <- df %>% filter(STIMULUS ==s) %>% filter(QUESTION ==q) %>%
group_by(Study,Sample) %>%
mutate(m=median(value)) ## calc median for printing on graph
x[[i]] <-
ggplot(d, aes(x = value, y = Study, fill = Sample, color = Sample, )) +
geom_density_ridges2(scale = 0.75, panel_scaling = TRUE, rel_min_height = 0.01, alpha = 0.25,
# ## POINT JITTER GEOMETRY
# jittered_points = TRUE, alpha = 0.7, scale = 0.9)+
# ## RUG GEOMETRY
jittered_points = TRUE,
position = position_points_jitter(width = 0.5, height = 0),
point_shape = '|', point_size = 3, point_alpha = 0.5) +
scale_x_continuous(limits=c(0,100)) +
scale_fill_manual(values = my_palettes(name="simple_samples", direction = "1")) +
scale_color_manual(values = my_palettes(name="simple_samples", direction = "1")) +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 5,
vjust=1.5, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
labs (title = q, y = "", x = "") +
guides(
y = guide_axis_manual(labels = labels[q,"left"]),
y.sec = guide_axis_manual(labels = labels[q,"right"]),
# x.sec = guide_axis_manual(position = "top", title = q, breaks = NULL)
) +
theme_ridges(grid = TRUE, center_axis_labels = TRUE) + easy_remove_legend()
}## END loop over questions
## JOIN QUESTION LEVEL PLOTS FOR THIS STIMULUS
title <- ref_stimuli %>% filter(ID == s) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste(s,"|",title)
p <- x[[1]] / x[[2]] /x[[3]] / x[[4]] /x[[5]] / x[[6]] /x[[7]]
p <- p + plot_annotation(
title = title,
subtitle ="", caption = "(point is median)")
## SAVE GRAPH FOR THIS STIMULIS
if(GRAPH_SAVE == TRUE) {
ggsave(plot = p, path="figs/FIG5_Descriptives", filename =paste0("SD_ridges_",s,".png"), units = c("in"), width = 8, height = 24, bg='#ffffff' )}
1}## END LOOP OVER STIMULICategorical Variables (Studies 1&2) (Block1)
## SETUP DATA
df <- df_graphs %>%
select(PID, Assigned.Block, Study, STIMULUS, ENCOUNTER, MAKER_ID, MAKER_AGE,MAKER_GENDER) %>%
filter(Study %in% c("Study1", "Study2")) %>%
filter(Assigned.Block ==1) %>%
mutate(Study = factor(Study, levels=order_study)) %>%
#reorder stimuli
mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0")))
######## FACETED BARPLOT MAKER
(ID <- df %>%
ggplot(aes(x=Study, fill=MAKER_ID)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="reds", direction = "1"))+
facet_grid( .~ STIMULUS) +
coord_flip() +
labs(title="MAKER_BY_STIMULUS_B1")
)
######## FACETED BARPLOT AGE
(AGE <- df %>%
ggplot(aes(x=Study, fill=MAKER_AGE)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "1"))+
facet_grid( .~ STIMULUS) +
coord_flip() +
labs(title="AGE_BY_STIMULUS_B1")
) 
######## FACETED BARPLOT GENDER
(GENDER <- df %>%
ggplot(aes(x=Study, fill=MAKER_GENDER)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1"))+
facet_grid( .~ STIMULUS) +
coord_flip()+
labs(title="GENDER_BY_STIMULUS_B1")
) 
######## FACETED BARPLOT ENCOUNTER
(ENCOUNTER <- df %>%
ggplot(aes(x=Study, fill=ENCOUNTER)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="encounter", direction = "1"))+
facet_grid( .~ STIMULUS) +
coord_flip() +
labs(title="ENCOUNTER_ID_BY_STIMULUS_B1")
)
if(GRAPH_SAVE){
ggsave(plot = ID, path="figs/FIG5_Descriptives", filename =paste0("MAKER_by_stimulus.png"), units = c("in"), width = 12, height = 2 , bg='#ffffff' )
ggsave(plot = AGE, path="figs/FIG5_Descriptives", filename =paste0("AGE_by_stimulus.png"), units = c("in"), width = 12, height = 2 , bg='#ffffff' )
ggsave(plot = GENDER, path="figs/FIG5_Descriptives", filename =paste0("GENDER_by_stimulus.png"), units = c("in"), width = 12, height = 2 , bg='#ffffff' )
ggsave(plot = ENCOUNTER, path="figs/FIG5_Descriptives", filename =paste0("ENCOUNTER_by_stimulus.png"), units = c("in"), width = 12, height = 2 , bg='#ffffff' )
}Categorical Variables Sankey (Study 3) (Block 1)
MAKER
### FILTER FOR ONLY ID QUESTION
df <- df_graphs_s3 %>%
mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0"))) %>%
select(PRE_ID, POST_ID, STIMULUS, PID) %>%
mutate(
PRE_ID = factor(PRE_ID, levels = rev(order_maker)),
POST_ID = factor(POST_ID, levels = rev(order_maker))
)
### {GGSANKEY} ################################
## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY
ds <- df %>%
##custom from ggsankey
make_long(PRE_ID, POST_ID, value=STIMULUS) %>%
mutate(
node = factor(node, levels=rev(order_maker)),
next_node= factor(next_node, levels=rev(order_maker)),
match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
)
(S <- ggplot(ds, aes(x = x,
next_x = next_x,
node = node,
next_node = next_node,
fill = node
))+
geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
# geom_sankey_text(aes( x = as.numeric(x), label = after_stat(freq)),
# size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
labs(title = "CHANGE in MAKER ID by STIMULUS",
x = "TIME", y = "(count)", fill = "MAKER",
caption = "") +
theme_minimal() + facet_grid(.~value)
)
#############################################
if(GRAPH_SAVE == TRUE) {
ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_ID_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8, bg='#ffffff' )
}AGE
### FILTER FOR ONLY AGE QUESTION
df <- df_graphs_s3 %>%
mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0"))) %>%
select(PRE_AGE, POST_AGE, STIMULUS, PID)
### {GGSANKEY} ################################
## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY
ds <- df %>%
##custom from ggsankey
make_long(PRE_AGE, POST_AGE, value=STIMULUS) %>%
mutate(
node = factor(node, levels=rev(order_age)),
next_node= factor(next_node,rev(order_age)),
match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
)
(S <- ggplot(ds, aes(x = x,
next_x = next_x,
node = node,
next_node = next_node,
fill = node
))+
geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
# geom_sankey_text(aes( x = as.numeric(x), label = after_stat(freq)),
# size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
labs(title = "CHANGE in AGE by STIMULUS",
x = "TIME", y = "(count)", fill = "AGE",
caption = "") +
theme_minimal() + facet_grid(.~value)
)
#############################################
if(GRAPH_SAVE == TRUE) {
ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_AGE_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8, bg='#ffffff' )
}GENDER
### FILTER FOR ONLY GENDER QUESTION
df <- df_graphs_s3 %>%
select(PRE_GENDER, POST_GENDER, STIMULUS, PID) %>%
mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0")))
### {GGSANKEY} ################################
## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY
ds <- df %>%
##custom from ggsankey
make_long(PRE_GENDER, POST_GENDER, value=STIMULUS) %>%
mutate(
node = factor(node, levels = rev(order_gender)),
next_node= factor(next_node, levels = rev(order_gender)),
match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
)
(S <- ggplot(ds, aes(x = x,
next_x = next_x,
node = node,
next_node = next_node,
fill = node
))+
geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
# geom_sankey_text(aes( x = as.numeric(x), label = after_stat(freq)),
# size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
labs(title = "CHANGE in GENDER by STIMULUS",
x = "TIME", y = "(count)", fill = "GENDER",
caption = "") +
theme_minimal() + facet_grid(.~value)
)
#############################################
if(GRAPH_SAVE == TRUE) {
ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_GENDER_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8, bg='#ffffff' )
}ENCOUNTER
### FILTER FOR ONLY GENDER QUESTION
df <- df_graphs_s3 %>%
select(PRE_ENCOUNTER, POST_ENCOUNTER, STIMULUS, PID) %>%
mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0")))
### {GGSANKEY} ################################
## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY
ds <- df %>%
##custom from ggsankey
make_long(PRE_ENCOUNTER, POST_ENCOUNTER, value=STIMULUS) %>%
mutate(
node = factor(node, levels = rev(order_encounter)),
next_node= factor(next_node, levels = rev(order_encounter)),
match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
)
(S <- ggplot(ds, aes(x = x,
next_x = next_x,
node = node,
next_node = next_node,
fill = node
))+
geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
# geom_sankey_text(aes( x = as.numeric(x), label = after_stat(freq)),
# size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
labs(title = "CHANGE in ENCOUNTER by STIMULUS",
x = "TIME", y = "(count)", fill = "ENCOUNTER",
caption = "") +
theme_minimal() + facet_grid(.~value)
)
#############################################
if(GRAPH_SAVE == TRUE) {
ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_ENCOUNTER_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8, bg='#ffffff' )
}(4.1.4) Exploratory Factor Analysis
As Reported in Section 4.1.4, and Figure 6, here we conduct an exploratory factor analysis of the short-form semantic differential scale questions for Studies 1 & 2.
This analysis was performed on the combined dataset from Study 1 (Tumblr) and Study 2 (Prolific). Both studies were run on all 6 stimulus blocks, meaning the data are balanced across all stimuli.
We use a parallel analysis method, verified by inspection of the scree plot to determine (f=4) factors, and see that both the KMO measure and Bartlett’s test of sphericity meet the necessary pre-requisites to support this analysis. The resultant factor loadings are described below.
## SETUP DATA
df <- df_graphs_all %>%
filter(Study %in% c("Study1","Study2"))
# %>% filter(STIMULUS !="B0-0") ## filtering out B0-0 doesn't change factors
x <- ref_min_sd_questions_z
# ## SANITY CHECK INCLUDED DDATA
# print("Dataset for EFA")
# addmargins(table(df$Study, df$Assigned.Block)/5)
## RUN EFA JAMOVI STYLE
jmv::efa(
data = df,
vars = as.vector(x),
# nFactors = 3,
extraction = "ml",
sortLoadings = FALSE,
screePlot = TRUE,
eigen = FALSE,
factorCor = TRUE,
factorSummary = TRUE,
modelFit = TRUE,
kmo = TRUE,
bartlett = TRUE)## Loading required namespace: GPArotation##
## EXPLORATORY FACTOR ANALYSIS
##
## Factor Loadings
## ───────────────────────────────────────────────────────────────────────
## 1 2 3 Uniqueness
## ───────────────────────────────────────────────────────────────────────
## DESIGN_z 0.9985577 0.004999781
## DATA_z 0.5598365 0.576833782
## POLITICS_z -0.5702053 0.716034927
## TRUST_z 0.5248731 -0.4350605 0.341614895
## ALIGN_z 0.8943077 0.207654559
## BEAUTY_z 0.3697155 -0.3581471 0.689074511
## INTENT_z 0.6250459 0.586348044
## ───────────────────────────────────────────────────────────────────────
## Note. 'Maximum likelihood' extraction method was used in
## combination with a 'oblimin' rotation
##
##
## FACTOR STATISTICS
##
## Summary
## ──────────────────────────────────────────────────────────
## Factor SS Loadings % of Variance Cumulative %
## ──────────────────────────────────────────────────────────
## 1 1.6251834 23.21691 23.21691
## 2 1.2636405 18.05201 41.26891
## 3 0.9886156 14.12308 55.39199
## ──────────────────────────────────────────────────────────
##
##
## Inter-Factor Correlations
## ──────────────────────────────────────
## 1 2 3
## ──────────────────────────────────────
## 1 — -0.1106452 -0.4111987
## 2 — 0.1962376
## 3 —
## ──────────────────────────────────────
##
##
## MODEL FIT
##
## Model Fit Measures
## ───────────────────────────────────────────────────────────────────────────────────────────────────
## RMSEA Lower Upper TLI BIC χ² df p
## ───────────────────────────────────────────────────────────────────────────────────────────────────
## 0.05470698 0.03157684 0.08101075 0.9622353 -4.836669 17.27780 3 0.0006196
## ───────────────────────────────────────────────────────────────────────────────────────────────────
##
##
## ASSUMPTION CHECKS
##
## Bartlett's Test of Sphericity
## ────────────────────────────────
## χ² df p
## ────────────────────────────────
## 2670.879 21 < .0000001
## ────────────────────────────────
##
##
## KMO Measure of Sampling Adequacy
## ────────────────────────────────
## MSA
## ────────────────────────────────
## Overall 0.6718293
## DESIGN_z 0.5239764
## DATA_z 0.6237950
## POLITICS_z 0.7215156
## TRUST_z 0.7187961
## ALIGN_z 0.6788071
## BEAUTY_z 0.7146919
## INTENT_z 0.6808428
## ────────────────────────────────
(4.2) Predicting Trust
In this section we describe a series of linear mixed effects models constructed to explore the relationship between trust, beauty and social attributions, as reported in section 4.2. Specifically, we test the hypotheses that 3 variables related to a visualization maker’s intent and competency (INTENT, ALIGNment, DATA skill) influence the relationship between beauty and trust.
SETUP MODEL DATA
This model includes data from Studies 1&2, as Study 3 used a pre-post design
df <- df_graphs_all %>%
# filter only Study 1 and 2
filter(Study %in% c("Study1","Study2"))
# ## SANITY CHECK DATA IN MODEL
# print("Data in Model")
# table(df$Study, df$Assigned.Block)M1 | TRUST ~ BEAUTY (REPORT FOR COMPARISON)
We begin by fitting a linear mixed effects, model predicting
CHART_TRUST by CHART_BEAUTY to see whether our
data support the claims made by Lin & Thorton, 2021.
(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)
################## FIT MODEL
f.B <- "TRUST ~ BEAUTY + (1|PID)"
mm.B <- lmer(TRUST_z ~ BEAUTY_z + (1|PID), data = df)
summary(mm.B)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z + (1 | PID)
## Data: df
##
## REML criterion at convergence: 4262.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.264 -0.513 0.015 0.571 3.254
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.09881 0.3143
## Residual 0.76949 0.8772
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) -0.01038 0.02819 315.51564 -0.368 0.713
## BEAUTY_z 0.35186 0.02300 1548.61812 15.295 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## BEAUTY_z -0.018car::Anova(mm.B, type=2)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## BEAUTY_z 233.94 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1performance(mm.B)## # Indices of model performance
##
## AIC | AICc | BIC | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## --------------------------------------------------------------------------------
## 4270.325 | 4270.350 | 4291.811 | 0.224 | 0.124 | 0.114 | 0.842 | 0.877################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.B, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.B, type = "pred", terms = "BEAUTY_z") + theme_minimal()
(g <- (e+p) + plot_annotation(title = f.B))
A model predicting TRUST by BEAUTY explains
22% variance in CHART_TRUST, with 12% variance explained by
a significant main effect of BEAUTY (\(t(1548) = 15.30, p <
.001\)). The model coefficient indicates that for every 1
standard deviation increase in BEAUTY,
CHART-TRUST increases on average by 0.35 SD.
Model 1 supports the argument of Lin & Thorton (2021) that graphs judged to be more attractive are also judged as more trustworthy.
M2 | TRUST ~ BEAUTY + INTENT
Here we add a main effect term INTENT as a predictor to
the previous model and compare fit with Model 1, to determine whether a
social attribution (in this case inference about the maker’s intent) is
also predictive of TRUST.
(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)
################## FIT MODEL
f.BI <- "TRUST ~ BEAUTY + INTENT + (1|PID)"
mm.BI <- lmer(TRUST_z ~ BEAUTY_z + INTENT_z + (1|PID), data = df)
summary(mm.BI)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z + INTENT_z + (1 | PID)
## Data: df
##
## REML criterion at convergence: 3944.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.1262 -0.5655 -0.0193 0.5750 3.2743
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.09258 0.3043
## Residual 0.62015 0.7875
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) -8.304e-03 2.610e-02 3.149e+02 -0.318 0.751
## BEAUTY_z 3.051e-01 2.088e-02 1.540e+03 14.616 <2e-16 ***
## INTENT_z -4.001e-01 2.109e-02 1.584e+03 -18.971 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) BEAUTY
## BEAUTY_z -0.018
## INTENT_z -0.004 0.115car::Anova(mm.BI, type=2)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## BEAUTY_z 213.61 1 < 2.2e-16 ***
## INTENT_z 359.90 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## COMPARE MODEL
compare_performance(mm.BI, mm.B, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## -------------------------------------------------------------------------
## mm.BI | lmerModLmerTest | 0.376 | 0.283 | 0.130 | 0.752 | 0.787
## mm.B | lmerModLmerTest | 0.224 | 0.124 | 0.114 | 0.842 | 0.877
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## --------------------------------------------------------------------
## mm.BI | 1.00 | 1.00 | 1.00 | 100.00%
## mm.B | 9.49e-71 | 9.55e-71 | 1.39e-69 | 0.00%anova(mm.BI, mm.B)## refitting model(s) with ML (instead of REML)## Data: df
## Models:
## mm.B: TRUST_z ~ BEAUTY_z + (1 | PID)
## mm.BI: TRUST_z ~ BEAUTY_z + INTENT_z + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm.B 4 4259.3 4280.8 -2125.7 4251.3
## mm.BI 5 3936.8 3963.7 -1963.4 3926.8 324.47 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BI, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.BI, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal()
(g <- (e+p) + plot_annotation(title = f.B, caption="low intent = inform, high intent = persuade"))
################## ALT PLOTS
# plot_model(mm.BI, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal()
# plot_model(mm.BI, type = "pred", terms = c("INTENT_z","BEAUTY_z")) + theme_minimal()A model predicting TRUST by a linear combination of
BEAUTY and INTENT explains 38% variance in
TRUST, with 28% variance explained by fixed effects
alone:
A significant main effect of
BEAUTY(\(t(1540) = 14.62, p <.001\)), andA significant main effect of
INTENT(\(t(1584) = -18.97, p <.001\)).The model coefficients indicates that for every 1 standard deviation increase in
BEAUTY,TRUSTincreases on average by 0.3 SD (more beauty corresponds to more trust). For every 1 standard deviation increase inINTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)TRUSTdecreases by 0.4 SD (more persuasive corresponds to less trustworthy).
Further, model comparisons indicate that MODEL 2 (including
CHART_INTENT) is a significantly better fit to the data
(\(\chi^2(1) = 324 , p < 0.001\))
than MODEL 1 including BEAUTY alone.
Model 2 supports our claim that social attributions (in this case, an inference about the communicative intent of the chart) also predict beauty, above and beyond the beauty-centric argument of Lin & Thorton (2021) that graphs judged to be more attractive are also judged as more trustworthy.
M3 | TRUST ~ BEAUTY X INTENT
Here we fit a model with INTENT as an
interaction with BEAUTY, and compare with
the previous model (with the simple linear combination of the two
predictors) to determine whether simply affecting TRUST,
the social attribution of INTENT moderates
the effect of BEAUTY on TRUST.
(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)
################## FIT MODEL
f.BxI <- "TRUST ~ BEAUTY X INTENT + (1|PID)"
mm.BxI <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + (1|PID), data = df)
summary(mm.BxI)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + (1 | PID)
## Data: df
##
## REML criterion at convergence: 3915.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.1758 -0.5956 -0.0174 0.5758 3.4158
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.09333 0.3055
## Residual 0.60543 0.7781
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.328e-03 2.606e-02 3.188e+02 0.166 0.868
## BEAUTY_z 2.995e-01 2.066e-02 1.536e+03 14.495 < 2e-16 ***
## INTENT_z -3.862e-01 2.100e-02 1.584e+03 -18.390 < 2e-16 ***
## BEAUTY_z:INTENT_z 1.126e-01 1.900e-02 1.566e+03 5.928 3.77e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) BEAUTY_z INTENT
## BEAUTY_z -0.022
## INTENT_z 0.005 0.109
## BEAUTY_:INT 0.082 -0.043 0.113car::Anova(mm.BxI, type=3) #type 3 tests for interaction model## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## (Intercept) 0.0276 1 0.8681
## BEAUTY_z 210.1141 1 < 2.2e-16 ***
## INTENT_z 338.2009 1 < 2.2e-16 ***
## BEAUTY_z:INTENT_z 35.1383 1 3.071e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## COMPARE MODEL
compare_performance(mm.BxI, mm.BI, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## --------------------------------------------------------------------------
## mm.BxI | lmerModLmerTest | 0.391 | 0.297 | 0.134 | 0.743 | 0.778
## mm.BI | lmerModLmerTest | 0.376 | 0.283 | 0.130 | 0.752 | 0.787
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## ---------------------------------------------------------------------
## mm.BxI | 1.000 | 1.000 | 1.000 | 100.00%
## mm.BI | 7.51e-08 | 7.57e-08 | 1.10e-06 | 0.00%anova(mm.BxI, mm.BI)## refitting model(s) with ML (instead of REML)## Data: df
## Models:
## mm.BI: TRUST_z ~ BEAUTY_z + INTENT_z + (1 | PID)
## mm.BxI: TRUST_z ~ BEAUTY_z * INTENT_z + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm.BI 5 3936.8 3963.7 -1963.4 3926.8
## mm.BxI 6 3904.0 3936.3 -1946.0 3892.0 34.808 1 3.638e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxI, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.BxI, type = "int", terms = c("INTENT_z","BEAUTY_z"),mdrt.values = "all") + theme_minimal()
(g <- (e+p) + plot_annotation(title = f.BxI, caption="low intent = inform, high intent = persuade", subtitle = f.BxI))
################## ALT PLOTS
# plot_model(mm.BxI, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal()
# plot_model(mm.BxI, type = "pred", terms = c("INTENT_z","BEAUTY_z")) + theme_minimal()A model predicting CHART-TRUST by a linear
interaction of CHART_BEAUTY and
CHART_INTENT explains 40% variance in
CHART_TRUST, with 30% variance explained by fixed effects
alone:
A significant main effect of
CHART_BEAUTY(\(\chi^2(1) = 210, p <.001\))A significant main effect of
CHART_INTENT(\(\chi^2(1) = 338, p <.001\))A significant interaction between
CHART_BEAUTYandCHART_INTENT(\(\chi^2(1) = 35, p <.001\))The model coefficients indicates that for every 1 standard deviation increase in
CHART-BEAUTY,CHART-TRUSTincreases on average by 0.3 SD (more beauty corresponds to more trust). For every 1 standard deviation increase inCHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)CHART-TRUSTdecreases on average by 0.4 SD (more persuasive corresponds to less trust). The significant interaction term indicates the difference in slope between the two main effects, that is to say, that the effect ofCHART_BEAUTYonCHART_TRUSTis moderated such that the effect ofCHART_BEAUTYis minimized whenCHART_INTENTis attributed as more informative (lower values of chart_intent) than persuasive (higher values of chart_intent) (Trust increases as a function of beauty MORE for more persuasive intents. The difference in trust for unattractive and attractive images intended to inform is lower. )
Further, model comparisons indicate that MODEL 3 (an interaction
rather than MODEL 2 with a linear combination of
CHART_BEAUTY and CHART_INTENT) is a
significantly better fit to the data (\(\chi^2(1)=34.81 , p < 0.001\)).
Model 3 supports our claim that social attributions (in this case, an inference about the communicative intent of the chart) also predict beauty, and in fact can change (moderate) the effect of beauty on trust.
M4 | TRUST ~ BEAUTY X INTENT + DATA
Here we add MAKER_DATA competency to our previous model
to determine whether a viewer’s inferences about the data analysis
ability of the chart’s maker affect assesments of the chart’s
trustworthiness.
(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)(
MAKER_DATA0 = professional in data analysis , 100 = layperson in data analysis)
################## FIT MODEL
f.BxID <- "TRUST ~ BEAUTY X INTENT + DATA (1|PID)"
mm.BxID <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1|PID), data = df)
summary(mm.BxID)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
## Data: df
##
## REML criterion at convergence: 3865
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9553 -0.5821 -0.0113 0.5773 3.0721
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.08655 0.2942
## Residual 0.58694 0.7661
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 1.882e-03 2.542e-02 3.186e+02 0.074 0.941
## BEAUTY_z 2.731e-01 2.063e-02 1.535e+03 13.242 < 2e-16 ***
## INTENT_z -3.373e-01 2.162e-02 1.585e+03 -15.602 < 2e-16 ***
## DATA_z -1.645e-01 2.174e-02 1.575e+03 -7.567 6.46e-14 ***
## BEAUTY_z:INTENT_z 1.041e-01 1.871e-02 1.568e+03 5.565 3.08e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) BEAUTY_z INTENT DATA_z
## BEAUTY_z -0.019
## INTENT_z 0.001 0.052
## DATA_z 0.013 0.172 -0.298
## BEAUTY_:INT 0.083 -0.032 0.089 0.059car::Anova(mm.BxID, type=3) #type 3 tests for interaction model## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## (Intercept) 0.0055 1 0.941
## BEAUTY_z 175.3494 1 < 2.2e-16 ***
## INTENT_z 243.4132 1 < 2.2e-16 ***
## DATA_z 57.2608 1 3.817e-14 ***
## BEAUTY_z:INTENT_z 30.9710 1 2.619e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## COMPARE MODEL
compare_performance(mm.BxID, mm.BxI, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## ---------------------------------------------------------------------------
## mm.BxID | lmerModLmerTest | 0.408 | 0.321 | 0.129 | 0.732 | 0.766
## mm.BxI | lmerModLmerTest | 0.391 | 0.297 | 0.134 | 0.743 | 0.778
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## ----------------------------------------------------------------------
## mm.BxID | 1.000 | 1.000 | 1.000 | 87.50%
## mm.BxI | 1.54e-12 | 1.56e-12 | 2.26e-11 | 12.50%anova(mm.BxID, mm.BxI)## refitting model(s) with ML (instead of REML)## Data: df
## Models:
## mm.BxI: TRUST_z ~ BEAUTY_z * INTENT_z + (1 | PID)
## mm.BxID: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm.BxI 6 3904.0 3936.3 -1946.0 3892.0
## mm.BxID 7 3849.6 3887.2 -1917.8 3835.6 56.395 1 5.929e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxID, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.BxID, type = "pred", terms = c("INTENT_z","DATA_z","BEAUTY_z")) + theme_minimal()
(g <- (e/p) + plot_annotation(title = f.BxID, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxID))
################## ALT PLOTS
# plot_model(mm.BxID, type = "pred", terms = c("BEAUTY_z", "INTENT_z","DATA_z")) + theme_minimal()
# plot_model(mm.BxID, type = "pred", terms = c("INTENT_z","BEAUTY_z","DATA_z")) + theme_minimal()
# plot_model(mm.BxID, type = "pred", terms = c("BEAUTY_z", "DATA_z","INTENT_z"))+ theme_minimal()A model predicting CHART-TRUST by a linear
interaction of CHART_BEAUTY and
CHART_INTENT as well as a main effect of
MAKER_DATA competency explains 41% variance in
CHART_TRUST, with 32% variance explained by fixed effects
alone:
A significant main effect of
CHART_BEAUTY(\(\chi^2(1) = 175, p <.001\))A significant main effect of
CHART_INTENT(\(\chi^2(1) = 243, p <.001\))A significant main effect of
MAKER_DATA(\(\chi^2(1) = 57, p <.001\))A significant interaction between
CHART_BEAUTYandCHART_INTENT(\(\chi^2(1) = 31, p <.001\))The model coefficients indicates that for every 1 standard deviation increase in
MAKER_DATA,CHART-TRUSTdecreases on average by 0.16 SD (less expertise/more layperson corresponds to lower trust). For every 1 standard deviation increase inCHART-BEAUTY,CHART-TRUSTincreases on average by 0.3 SD (more beauty corresponds to more trust). For every 1 standard deviation increase inCHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)CHART-TRUSTdecreases on average by 0.3 SD ( persuasive corresponds to less trust; informative corresponds to more trust). The significant interaction term indicates the difference in slope between the main effects forCHART_BEAUTYandCHART_INTENT, that is to say, that the effect ofCHART_BEAUTYonCHART_TRUSTis moderated such that the effect ofCHART_BEAUTYis minimized whenCHART_INTENTis attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)
Further, model comparisons indicate that MODEL 4 (adding a simple
main effect of MAKER_DATA) is a significantly better fit to
the data than MODEL 3 without the MAKER_DATA fixed effect
(\(\chi^2(1)=56.4 , p < 0.001\))
.
Model 4 supports our claim that social attributions (in this case, both an inference about the communicative intent of the chart and inference about the data analysis skill of the maker) also predict beauty, and in fact can change (in the case of intent, moderate) the effect of beauty on trust.
M5 | TRUST ~ BEAUTY X INTENT X DATA
Here we add an interaction with MAKER_DATA competency to
our previous model to determine whether a viewer’s inferences about the
data analysis ability of the chart’s maker MODERATE the effects of
INTENT and BEAUTY on assesments of trustworthiness.
(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)(
MAKER_DATA0 = professional in data analysis , 100 = layperson in data analysis)
################## FIT MODEL
f.BxIxD <- "TRUST ~ BEAUTY X INTENT X DATA (1|PID)"
mm.BxIxD <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z * DATA_z + (1|PID), data = df)
summary(mm.BxIxD)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z * DATA_z + (1 | PID)
## Data: df
##
## REML criterion at convergence: 3878.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.8950 -0.5852 -0.0185 0.5869 2.9601
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.08781 0.2963
## Residual 0.58529 0.7650
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 1.358e-02 2.629e-02 3.517e+02 0.516 0.6058
## BEAUTY_z 2.756e-01 2.139e-02 1.530e+03 12.885 < 2e-16 ***
## INTENT_z -3.403e-01 2.184e-02 1.582e+03 -15.581 < 2e-16 ***
## DATA_z -1.676e-01 2.195e-02 1.572e+03 -7.637 3.83e-14 ***
## BEAUTY_z:INTENT_z 9.515e-02 1.970e-02 1.553e+03 4.830 1.50e-06 ***
## BEAUTY_z:DATA_z 6.497e-03 1.998e-02 1.578e+03 0.325 0.7451
## INTENT_z:DATA_z -4.248e-02 2.026e-02 1.563e+03 -2.097 0.0362 *
## BEAUTY_z:INTENT_z:DATA_z -2.032e-02 1.714e-02 1.565e+03 -1.186 0.2358
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) BEAUTY_z INTENT_z DATA_z BEAUTY_z:INTENT_ BEAUTY_:D
## BEAUTY_z -0.036
## INTENT_z 0.009 0.018
## DATA_z 0.017 0.147 -0.274
## BEAUTY_z:INTENT_ 0.010 -0.037 0.076 0.040
## BEAUTY_:DAT 0.105 0.064 0.044 0.095 -0.259
## INTENT_:DAT -0.201 0.039 0.032 0.063 0.152 0.099
## BEAUTY_:INTENT_: 0.008 -0.245 0.137 0.098 0.044 -0.049
## INTENT_:
## BEAUTY_z
## INTENT_z
## DATA_z
## BEAUTY_z:INTENT_
## BEAUTY_:DAT
## INTENT_:DAT
## BEAUTY_:INTENT_: 0.241car::Anova(mm.BxIxD, type=3) #type 3 tests for interaction model## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## (Intercept) 0.2667 1 0.6055
## BEAUTY_z 166.0242 1 < 2.2e-16 ***
## INTENT_z 242.7586 1 < 2.2e-16 ***
## DATA_z 58.3287 1 2.218e-14 ***
## BEAUTY_z:INTENT_z 23.3297 1 1.365e-06 ***
## BEAUTY_z:DATA_z 0.1057 1 0.7451
## INTENT_z:DATA_z 4.3971 1 0.0360 *
## BEAUTY_z:INTENT_z:DATA_z 1.4063 1 0.2357
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## COMPARE MODEL
compare_performance(mm.BxIxD, mm.BxID, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## ----------------------------------------------------------------------------
## mm.BxIxD | lmerModLmerTest | 0.411 | 0.323 | 0.130 | 0.730 | 0.765
## mm.BxID | lmerModLmerTest | 0.408 | 0.321 | 0.129 | 0.732 | 0.766
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------
## mm.BxIxD | 0.393 | 0.385 | 2.05e-04 | 62.50%
## mm.BxID | 0.607 | 0.615 | 1.000 | 37.50%anova(mm.BxIxD, mm.BxID)## refitting model(s) with ML (instead of REML)## Data: df
## Models:
## mm.BxID: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
## mm.BxIxD: TRUST_z ~ BEAUTY_z * INTENT_z * DATA_z + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm.BxID 7 3849.6 3887.2 -1917.8 3835.6
## mm.BxIxD 10 3850.5 3904.2 -1915.3 3830.5 5.1278 3 0.1627################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
# e <- plot_model(mm.BxIxD, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
# ## PLOT MODEL PREDICTIONS
# p <- plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z","INTENT_z", "DATA_z")) + theme_minimal()
# (g <- (e/p) + plot_annotation(title = f.BxID, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxIxD))
################## ALT PLOTS
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "BEAUTY_z")) + theme_minimal() + labs(subtitle ="sig ixn beauty x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "DATA_z")) + theme_minimal() + labs(subtitle ="sig ixn data x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z", "DATA_z")) + theme_minimal() + labs(subtitle ="NO IXN BEAUTY x DATA")
# plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z","DATA_z", "INTENT_z")) + theme_minimal()Here we see that the three-way interaction between BEAUTY X INTENT X DATA is not statistically significant. (\(\chi^2(1) = 1.4, p =0.24\)). There is a significant 2-way interaction between INTENT & DATA, such that increased DATA competency (low data values) lessen the effect of intent on trust. However there is NOT a significant interaction between DATA and BEAUTY (the maker’s skill in data analysis does not affect the relationship between beauty and trust)
The more complicated model is not a significantly better fit, and so we keep the simpler model (no three-way interaction). (\(\chi^2(3)=5.13 , p = 0.16\)) .
M6 | TRUST ~ BEAUTY X INTENT + DATA + ALIGN
Here we add a main effect of ALIGNMENT to our previous
model to determine whether a viewer’s attitudes about how the maker’s
values align with their own affect assesments of trustworthiness.
(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)(
MAKER_DATA0 = professional in data analysis , 100 = layperson in data analysis)(
ALIGN0 = does NOTshare my values , 100 = DOES SHARE my values)
################## FIT MODEL
f.BxIDA <- "TRUST ~ BEAUTY X INTENT + DATA + ALIGN (1|PID)"
mm.BxIDA <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1|PID), data = df)
summary(mm.BxIDA)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1 | PID)
## Data: df
##
## REML criterion at convergence: 3342.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.5904 -0.5572 -0.0499 0.5320 5.2784
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.07244 0.2691
## Residual 0.41451 0.6438
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) -5.216e-03 2.218e-02 3.187e+02 -0.235 0.814
## BEAUTY_z 1.084e-01 1.860e-02 1.520e+03 5.832 6.69e-09 ***
## INTENT_z -2.315e-01 1.878e-02 1.580e+03 -12.325 < 2e-16 ***
## DATA_z -1.647e-01 1.838e-02 1.566e+03 -8.960 < 2e-16 ***
## ALIGN_z 4.754e-01 1.897e-02 1.541e+03 25.053 < 2e-16 ***
## BEAUTY_z:INTENT_z 7.541e-02 1.586e-02 1.558e+03 4.755 2.17e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) BEAUTY_z INTENT DATA_z ALIGN_
## BEAUTY_z -0.013
## INTENT_z -0.002 -0.032
## DATA_z 0.012 0.161 -0.291
## ALIGN_z -0.013 -0.351 0.226 -0.002
## BEAUTY_:INT 0.081 -0.004 0.072 0.060 -0.073car::Anova(mm.BxIDA, type=3) #type 3 tests for interaction model## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## (Intercept) 0.0553 1 0.8141
## BEAUTY_z 34.0090 1 5.486e-09 ***
## INTENT_z 151.9023 1 < 2.2e-16 ***
## DATA_z 80.2863 1 < 2.2e-16 ***
## ALIGN_z 627.6728 1 < 2.2e-16 ***
## BEAUTY_z:INTENT_z 22.6114 1 1.983e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## COMPARE MODEL
compare_performance(mm.BxIDA, mm.BxID, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## ----------------------------------------------------------------------------
## mm.BxIDA | lmerModLmerTest | 0.581 | 0.508 | 0.149 | 0.612 | 0.644
## mm.BxID | lmerModLmerTest | 0.408 | 0.321 | 0.129 | 0.732 | 0.766
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------
## mm.BxIDA | 1.00 | 1.00 | 1.00 | 100.00%
## mm.BxID | 2.24e-115 | 2.27e-115 | 3.29e-114 | 0.00%anova(mm.BxIDA, mm.BxID)## refitting model(s) with ML (instead of REML)## Data: df
## Models:
## mm.BxID: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
## mm.BxIDA: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm.BxID 7 3849.6 3887.2 -1917.8 3835.6
## mm.BxIDA 8 3321.7 3364.6 -1652.8 3305.7 529.98 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxIDA, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p1 <- plot_model(mm.BxIDA, type = "pred", terms = c("BEAUTY_z","INTENT_z")) + theme_minimal()
p2 <- plot_model(mm.BxIDA, type = "pred", terms = c("DATA_z","ALIGN_z")) + theme_minimal()
(g <- (e/p1/p2) + plot_annotation(title = f.BxIDA, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxIDA))
## see each two-way interaction
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "BEAUTY_z")) + theme_minimal() + labs(subtitle ="sig ixn beauty x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "DATA_z")) + theme_minimal() + labs(subtitle ="sig ixn data x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z", "DATA_z")) + theme_minimal() + labs(subtitle ="NO IXN BEAUTY x DATA")A model predicting CHART-TRUST by a linear combination
of maker ALIGNment with DATA competency and an
interaction of CHART_BEAUTY and
CHART_INTENT as explains 58% variance in
CHART_TRUST, with 51% variance explained by fixed effects
alone:
A significant main effect of
CHART_BEAUTY(\(\chi^2(1) = 34, p <.001\))A significant main effect of
CHART_INTENT(\(\chi^2(1) = 152, p <.001\))A significant main effect of
MAKER_DATA(\(\chi^2(1) = 80, p <.001\))A significant main effect of
MAKER_ALIGN(\(\chi^2(1) = 628, p <.001\))A significant interaction between
CHART_BEAUTYandCHART_INTENT(\(\chi^2(1) = 31, p <.001\))The model standardized beta coefficients indicates that for every 1 standard deviation increase
MAKER_DATA(more layperson, less professional),CHART-TRUSTdecreases on average by 0.17 SD (less professional corresponds with less trust). For every in 1 standard deviation increase inMAKER_ALIGN(more values shared)CHART-TRUSTincreases on average by 0.5 SD (more alignment corresponds with more trust). For every 1 standard deviation increase inCHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)CHART-TRUSTdecreases on average by 0.23 SD ( persuasive corresponds to less trust; informative corresponds to more trust). And for every in 1 standard deviation increase inCHART_BEAUTYtrustworthiness increases by 0.2 SD on average. The significant interaction term indicates the difference in slope between the main effects forCHART_BEAUTYandCHART_INTENT, that is to say, that the effect ofCHART_BEAUTYonCHART_TRUSTis moderated such that the effect ofCHART_BEAUTYis minimized whenCHART_INTENTis attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)
Further, model comparisons indicate that MODEL 6 (adding a simple
main effect of MAKER_ALIGN) is a significantly better fit
to the data than MODEL 4 without the fixed effect (\(\chi^2(1)= 529 , p < 0.001\)) .
Model 6 supports our claim that social attributions (in this case, both an inference about the communicative intent of the chart and inference about the data analysis skill of the maker and the extent to which the maker’s values align with the participants’) also predict beauty, and in fact can change (in the case of intent, moderate) the effect of beauty on trust.
M7 | TRUST ~ BEAUTY X INTENT + INTENT X ALIGN + DATA
ALIGNMENT moderates INTENT (more alignment mitigates differences in trust based on intent; the more aligned the values are the less difference there is in trust based on intent to inform vs. to persuade) 2.
INTENT moderates BEAUTY (more beauty mitigates differences in trust based on intent; the more beautiful the less difference there is in trust based on intent to inform or persuade)
MAIN EFFECT DATA (less professional => less trustworthy)
MAIN EFFECT INTENT (more persuasive => less trustworthy)
MAIN EFFECT ALIGNMENT (more aligned => more trustworthy)
MAIN EFFECT BEAUTY (more beautify => more trustworthy)
Here we add ALIGNMENT as an interaction term to our
previous model to determine whether a viewer’s attitudes about how the
maker’s values align with their own might moderate the effects of intent
and beauty on assesments of trustworthiness.
(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)(
MAKER_DATA0 = professional in data analysis , 100 = layperson in data analysis)(
ALIGN0 = does NOTshare my values , 100 = DOES SHARE my values)
################## FIT MODEL
f.BxIxAD <- "TRUST ~ BEAUTY X INTENT + INTENT X ALIGN + DATA + (1|PID)"
mm.BxIxAD <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z*ALIGN_z + DATA_z + (1|PID), data = df)
summary(mm.BxIxAD)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + DATA_z +
## (1 | PID)
## Data: df
##
## REML criterion at convergence: 3339
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6647 -0.5594 -0.0526 0.5321 4.9381
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.07417 0.2723
## Residual 0.41086 0.6410
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 6.535e-03 2.255e-02 3.324e+02 0.290 0.77214
## BEAUTY_z 1.088e-01 1.853e-02 1.517e+03 5.869 5.39e-09 ***
## INTENT_z -2.269e-01 1.878e-02 1.578e+03 -12.081 < 2e-16 ***
## ALIGN_z 4.634e-01 1.927e-02 1.543e+03 24.049 < 2e-16 ***
## DATA_z -1.651e-01 1.832e-02 1.563e+03 -9.013 < 2e-16 ***
## BEAUTY_z:INTENT_z 5.428e-02 1.713e-02 1.536e+03 3.168 0.00157 **
## INTENT_z:ALIGN_z 5.148e-02 1.607e-02 1.560e+03 3.204 0.00138 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) BEAUTY_z INTENT_z ALIGN_ DATA_z BEAUTY_:
## BEAUTY_z -0.011
## INTENT_z 0.011 -0.031
## ALIGN_z -0.044 -0.346 0.206
## DATA_z 0.011 0.161 -0.291 0.000
## BEAUTY_:INT 0.011 -0.007 0.037 0.008 0.059
## INTENT_:ALI 0.162 0.008 0.077 -0.192 -0.009 -0.386car::Anova(mm.BxIxAD, type=3) #type 3 tests for interaction model## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## (Intercept) 0.084 1 0.771962
## BEAUTY_z 34.440 1 4.395e-09 ***
## INTENT_z 145.956 1 < 2.2e-16 ***
## ALIGN_z 578.346 1 < 2.2e-16 ***
## DATA_z 81.228 1 < 2.2e-16 ***
## BEAUTY_z:INTENT_z 10.036 1 0.001535 **
## INTENT_z:ALIGN_z 10.265 1 0.001356 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## COMPARE MODEL
compare_performance(mm.BxIxAD, mm.BxIDA, mm.BxID, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## -----------------------------------------------------------------------------
## mm.BxIxAD | lmerModLmerTest | 0.585 | 0.511 | 0.153 | 0.609 | 0.641
## mm.BxIDA | lmerModLmerTest | 0.581 | 0.508 | 0.149 | 0.612 | 0.644
## mm.BxID | lmerModLmerTest | 0.408 | 0.321 | 0.129 | 0.732 | 0.766
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## ------------------------------------------------------------------------
## mm.BxIxAD | 0.984 | 0.984 | 0.808 | 100.00%
## mm.BxIDA | 0.016 | 0.016 | 0.192 | 62.67%
## mm.BxID | 3.59e-117 | 3.67e-117 | 6.34e-115 | 0.00%anova(mm.BxIxAD, mm.BxIDA)## refitting model(s) with ML (instead of REML)## Data: df
## Models:
## mm.BxIDA: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1 | PID)
## mm.BxIxAD: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + DATA_z + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm.BxIDA 8 3321.7 3364.6 -1652.8 3305.7
## mm.BxIxAD 9 3313.4 3361.8 -1647.7 3295.4 10.24 1 0.001375 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxIxAD, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p1 <- plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","INTENT_z","DATA_z")) + theme_minimal()
p2 <- plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z","INTENT_z","DATA_z")) + theme_minimal()
(g <- (e/p1/p2) + plot_annotation(title = f.BxIxAD, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxIxAD))
## alternative plots
# print("two-way interaction")
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal() + labs(subtitle ="sig ixn intent x beauty", caption="INTENT matters MORE less beautiful")
# plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z", "INTENT_z")) + theme_minimal() + labs(subtitle ="sig ixn intent align")
#
# plot_model(mm.BxIxAD, type = "pred", terms = c("INTENT_z","ALIGN_z")) + theme_minimal()
#
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z", "ALIGN_z")) + theme_minimal() + labs(subtitle ="NO IXN beauty align", caption = "MAIN EFFECT ALIGN; more aligned more trustworthy")
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z", "DATA_z")) + theme_minimal() + labs(subtitle ="MAIN EFFECT DATA", caption = "MAIN EFFECT DATA; more professional = more trustworthy")
#
# ## plot all combinations
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","INTENT_z","ALIGN_z")) + theme_minimal() # facet align
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","ALIGN_z","INTENT_z")) + theme_minimal() # facet intent
#
# plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z","INTENT_z","BEAUTY_z")) + theme_minimal() # facet intent
# plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z","BEAUTY_z","INTENT_z")) + theme_minimal() # facet intent
#
# plot_model(mm.BxIxAD, type = "pred", terms = c("INTENT_z","BEAUTY_z","ALIGN_z")) + theme_minimal() # facet intent
# plot_model(mm.BxIxAD, type = "pred", terms = c("INTENT_z","ALIGN_z","BEAUTY_z")) + theme_minimal() # facet intent
#
### PLOT WITH DATA EFFECT
plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","INTENT_z","ALIGN_z","DATA_z")) + theme_minimal() # facet align
plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","ALIGN_z","INTENT_z","DATA_z")) + theme_minimal() # facet intent
A model predicting CHART-TRUST explains 59% variance in
CHART_TRUST, with 51% variance explained by fixed effects
alone:
A significant main effect of
CHART_BEAUTY(\(\chi^2(1) = 34, p <.001\)) For every in 1 standard deviation increase inCHART_BEAUTYtrustworthiness increases by 0.1 SD on average.A significant main effect of
CHART_INTENT(\(\chi^2(1) = 146, p <.001\)). For every 1 standard deviation increase inCHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)CHART-TRUSTdecreases on average by 0.23 SD ( persuasive corresponds to less trust; informative corresponds to more trust).A significant main effect of
MAKER_ALIGN(\(\chi^2(1) = 578, p <.001\)). For every in 1 standard deviation increase inMAKER_ALIGN(more values shared)CHART-TRUSTincreases on average by 0.5 SD (more alignment corresponds with more trust).A significant main effect of
MAKER_DATA(\(\chi^2(1) = 81, p <.001\)). The model standardized beta coefficients indicates that for every 1 standard deviation increaseMAKER_DATA(more layperson, less professional),CHART-TRUSTdecreases on average by 0.17 SD (less professional corresponds with less trust).A significant interaction between
CHART_BEAUTYandCHART_INTENT(\(\chi^2(1) = 31, p <.001\)). The significant interaction term indicates the difference in slope between the main effects forCHART_BEAUTYandCHART_INTENT, that is to say, that the effect ofCHART_BEAUTYonCHART_TRUSTis moderated such that the effect ofCHART_BEAUTYis minimized whenCHART_INTENTis attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)A significant interaction between
CHART_INTENTandCHART_ALIGN(\(\chi^2(1) = 31, p <.001\)) The significant interaction term indicates that the difference in slope between the main effects forCHART_INTENTandMAKER_ALIGN, that is to say that the effect of intent on trust is moderated such that the effect of intent on trust is minimized the the more aligned a viewer feels with the maker. For less alignment, there is a greater difference in trust for persuasive vs. informative images; when the alignment is high, the trustworthiness of persuasive and informative images converge.The significant interaction term indicates the difference in slope between the main effects for
CHART_BEAUTYandCHART_INTENT, that is to say, that the effect ofCHART_BEAUTYonCHART_TRUSTis moderated such that the effect ofCHART_BEAUTYis minimized whenCHART_INTENTis attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)
Further, model comparisons indicate that MODEL 7 (adding an
interaction with MAKER_ALIGN) is a significantly better fit
to the data than the MODEL 6 without the interaction term MODEL 4
without the fixed effect (\(\chi^2(1)= 10.24 ,
p < 0.001\)) .
Model 7 supports our claim that social attributions (in this case, both an inference about the communicative intent of the chart and inference about the data analysis skill of the maker and the extent to which the maker’s values align with the participants’) also predict beauty, and in fact can change (in the case of intent, moderate) the effect of beauty on trust.
M8 | TRUST ~ BEAUTY X INTENT + INTENT X ALIGN (REMOVE DATA)
HERE we test whether we really actually need the DATA main effect
################## FIT MODEL
f.BxIxA <- "TRUST ~ BEAUTY X INTENT + INTENT X ALIGN + (1|PID)"
mm.BxIxA <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + (1|PID), data = df)
summary(mm.BxIxA)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + (1 | PID)
## Data: df
##
## REML criterion at convergence: 3412.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.8961 -0.5668 -0.0730 0.5163 4.3065
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 0.07926 0.2815
## Residual 0.43089 0.6564
## Number of obs: 1590, groups: PID, 318
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 8.718e-03 2.319e-02 3.322e+02 0.376 0.707245
## BEAUTY_z 1.355e-01 1.874e-02 1.517e+03 7.231 7.57e-13 ***
## INTENT_z -2.762e-01 1.842e-02 1.577e+03 -15.000 < 2e-16 ***
## ALIGN_z 4.633e-01 1.975e-02 1.543e+03 23.461 < 2e-16 ***
## BEAUTY_z:INTENT_z 6.334e-02 1.753e-02 1.536e+03 3.614 0.000312 ***
## INTENT_z:ALIGN_z 5.027e-02 1.647e-02 1.560e+03 3.053 0.002306 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) BEAUTY_z INTENT_z ALIGN_ BEAUTY_:
## BEAUTY_z -0.013
## INTENT_z 0.015 0.017
## ALIGN_z -0.044 -0.350 0.215
## BEAUTY_:INT 0.010 -0.016 0.057 0.008
## INTENT_:ALI 0.162 0.010 0.078 -0.192 -0.386car::Anova(mm.BxIxA, type=3) #type 3 tests for interaction model## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: TRUST_z
## Chisq Df Pr(>Chisq)
## (Intercept) 0.1413 1 0.7070049
## BEAUTY_z 52.2871 1 4.795e-13 ***
## INTENT_z 224.9862 1 < 2.2e-16 ***
## ALIGN_z 550.4328 1 < 2.2e-16 ***
## BEAUTY_z:INTENT_z 13.0587 1 0.0003019 ***
## INTENT_z:ALIGN_z 9.3192 1 0.0022677 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1################## COMPARE MODEL
compare_performance(mm.BxIxA, mm.BxIxAD, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma
## -----------------------------------------------------------------------------
## mm.BxIxAD | lmerModLmerTest | 0.585 | 0.511 | 0.153 | 0.609 | 0.641
## mm.BxIxA | lmerModLmerTest | 0.565 | 0.486 | 0.155 | 0.623 | 0.656
##
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## ------------------------------------------------------------------------
## mm.BxIxAD | 1.00 | 1.00 | 1.000 | 87.50%
## mm.BxIxA | 1.44e-17 | 1.46e-17 | 2.11e-16 | 12.50%anova(mm.BxIxA, mm.BxIxAD)## refitting model(s) with ML (instead of REML)## Data: df
## Models:
## mm.BxIxA: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + (1 | PID)
## mm.BxIxAD: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + DATA_z + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm.BxIxA 8 3391.0 3434.0 -1687.5 3375.0
## mm.BxIxAD 9 3313.4 3361.8 -1647.7 3295.4 79.558 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Yes, model 7 is better is a significantly better fit that the more complex Model 8 (\(\chi^2(1)= 80 , p < 0.001\)) .
MODEL FIGURE (FIG 7) Predicting Trust
Here we produce the visualization and model parameters table reported in Figure 7.
## SET BEST MODEL
m.best <- mm.BxIxAD
f.best <- f.BxIxAD
name="BxIxAD"
## SAVE BEST MODEL
saveRDS(m.best, file = paste0("models/TRUST_bestfit_","BxIxAD",".rds"))
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
(e <- plot_model(m.best, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal())
## PLOT MODEL PREDICTIONS
(p <- plot_model(m.best, type = "pred", terms = c("BEAUTY_z","INTENT_z","ALIGN_z")) + theme_minimal())
(g <- (e / p) + plot_annotation(title = f.best, caption="INTENT [inform <--> persuade] \n ALIGN[does NOT share <--> DOES share my values]"))
################## PRINT MODEL TABLE
# (t <- tab_model(m.best, file = "tab.html"))
# library(webshot)
# webshot("tab.html", "figs/FIG7_Trust_Model/TRUST_model_table.png")
############
ggsave(plot= e, path="figs/FIG7_Trust_Model", filename = "TRUST_model_coefficients.png",units = c("in"), width = 8, height = 8,bg='#ffffff')
ggsave(plot = g, path="figs/FIG7_Trust_Model", filename =paste0("TRUST_model.png"), units = c("in"), width = 8, height = 10,bg='#ffffff' )CALCULATE PARTIAL R2
## <!-- https://chatgpt.com/c/67d6271c-15dc-800e-9e81-aa2b07a84d52 -->
## CAUTION THIS TAKES A VERY LONG TIME TO RUN
# # install.packages("partR2")
# library(partR2)
# library(future)
# library(furrr)
# #
# # ## setup multiple cores to
# plan(multisession, workers = 4)
# #
# # # Mixed model
# model <- m.best
#
# ######## GROUP PREDICTORS
#
# # run Partial R2
# result <- partR2(
# model,
# partbatch = list(
# "BEAUTY" = "BEAUTY_z",
# "ALIGN" = "ALIGN_z",
# "INTENT" = "INTENT_z",
# "DATA" = "DATA_z",
# "BEAUTY:INTENT" = "BEAUTY_z:INTENT_z",
# "ALIGN:INTENT" = "INTENT_z:ALIGN_z"
# ),
# nboot = 1000
# )
# Print
# summary(result, sort = TRUE)
# saveRDS(result, file = "models/TRUST_bestfit_mm.BxIxAD_partR2.rds")DISPLAY PARTIAL R2
## LOAD PARTIAL R ANALYSIS
partialR <- readRDS("models/TRUST_bestfit_mm.BxIxAD_partR2.rds") # sd questions LONG
# run the following line to see stored values for partR2
# print(partialR, sort=TRUE)OTHER BLOCKS
Semantic Differential Questions (Other Blocks)
This plots the short-form set of semantic differential questions for each stimulus for Studies 1 & 2. Note that the blue ridge refers to Study 1, and black ridge to Study 2. (Note: these plots are written to the figs directory, not displayed inline)
#### DENSITY RIDGES#############################################################################
#### loop over questions and stimuli, vertically stack studies, color by sample
## DEFINE DF
df <- df_sd_questions_long_all%>%
#only block 1 for balanced data
filter(Assigned.Block!=1) %>%
#drop pilot data
filter(Study != "Study0") %>%
#for Study 3 ONLY, set SAMPLE = TIME (for graphing purpose)
mutate(
Sample = case_when(Study =="Study3" ~ TIME ,
.default = Sample)) %>%
# mutate(Sample = factor(Sample, levels = c("TUMBLR","GENERAL","POST","PRE"))) %>%
mutate(Study = factor(Study, levels=order_study)) %>%
droplevels()
## DEFINE REFS
n_q <- length(levels(df$QUESTION))
stimuli <- levels(df$STIMULUS)
questions <- ref_min_sd_questions #has qs in right order
labels <- ref_labels_min
## SET INITIAL VALUES
s <- stimuli[1]
q <- questions[1]
x = list() #list of plots
## LOOP OVER STIMULI, LOOP OVER QUESTIONS
for (s in stimuli){
i=0
# print(s)
for (q in questions) {
i = i+1
# print(i)
# print(q)
## FILTER Q AND CALCULATE MEDIAN
d <- df %>% filter(STIMULUS ==s) %>% filter(QUESTION ==q) %>%
group_by(Study,Sample) %>%
mutate(m=median(value)) ## calc median for printing on graph
x[[i]] <-
ggplot(d, aes(x = value, y = Study, fill = Sample, color = Sample )) +
geom_density_ridges2(scale = 0.75, panel_scaling = TRUE, rel_min_height = 0.01, alpha = 0.25,
# ## POINT JITTER GEOMETRY
# jittered_points = TRUE, alpha = 0.7, scale = 0.9)+
# ## RUG GEOMETRY
jittered_points = TRUE,
position = position_points_jitter(width = 0.5, height = 0),
point_shape = '|', point_size = 3, point_alpha = 0.5) +
scale_x_continuous(limits=c(0,100)) +
scale_fill_manual(values = my_palettes(name="simple_samples", direction = "1")) +
scale_color_manual(values = my_palettes(name="simple_samples", direction = "1")) +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 5,
vjust=1.5, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
labs (title = q, y = "", x = "") +
guides(
y = guide_axis_manual(labels = labels[q,"left"]),
y.sec = guide_axis_manual(labels = labels[q,"right"]),
# x.sec = guide_axis_manual(position = "top", title = q, breaks = NULL)
) +
theme_ridges(grid = TRUE, center_axis_labels = TRUE) + easy_remove_legend()
}## END loop over questions
## JOIN QUESTION LEVEL PLOTS FOR THIS STIMULUS
title <- ref_stimuli %>% filter(ID == s) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste(s,"|",title)
p <- x[[1]] / x[[2]] /x[[3]] / x[[4]] /x[[5]] / x[[6]] /x[[7]]
p <- p + plot_annotation(
title = title,
subtitle ="", caption = "(point is median)")
## SAVE GRAPH FOR THIS STIMULIS
if(GRAPH_SAVE == TRUE) {
ggsave(plot = p, path="figs/OTHER_Blocks", filename =paste0("SD_ridges_",s,".png"), units = c("in"), width = 8, height = 24, bg='#ffffff' )}
1}## END LOOP OVER STIMULICategorical Questions (Other Blocks)
## SETUP DATA
df <- df_graphs %>%
select(PID, Assigned.Block, Study, STIMULUS, ENCOUNTER, MAKER_ID, MAKER_AGE,MAKER_GENDER) %>%
filter(Study %in% c("Study1", "Study2")) %>%
filter(Assigned.Block !=1) %>%
mutate(Study = factor(Study, levels=order_study))
######## FACETED BARPLOT MAKER
(ID <- df %>%
ggplot(aes(x=Study, fill=MAKER_ID)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="reds", direction = "1"))+
facet_wrap( .~ STIMULUS) +
coord_flip() +
labs(title="MAKER_BY_STIMULUS")
)
######## FACETED BARPLOT AGE
(AGE <- df %>%
ggplot(aes(x=Study, fill=MAKER_AGE)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "1"))+
facet_wrap( .~ STIMULUS) +
coord_flip() +
labs(title="AGE_BY_STIMULUS")
) 
######## FACETED BARPLOT GENDER
(GENDER <- df %>%
ggplot(aes(x=Study, fill=MAKER_GENDER)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1"))+
facet_wrap( .~ STIMULUS) +
coord_flip()+
labs(title="GENDER_BY_STIMULUS")
) 
######## FACETED BARPLOT ENCOUNTER
(ENCOUNTER <- df %>%
ggplot(aes(x=Study, fill=ENCOUNTER)) +
geom_bar(position="fill") +
scale_fill_manual(values = my_palettes(name="encounter", direction = "1"))+
facet_wrap( .~ STIMULUS) +
coord_flip() +
labs(title="ENCOUNTER_ID_BY_STIMULUS")
)
if(GRAPH_SAVE){
ggsave(plot = ID, path="figs/OTHER_Blocks", filename =paste0("MAKER_by_stimulus.png"), units = c("in"), width = 12, height = 12 , bg='#ffffff' )
ggsave(plot = AGE, path="figs/OTHER_Blocks", filename =paste0("AGE_by_stimulus.png"), units = c("in"), width = 12, height = 12 , bg='#ffffff' )
ggsave(plot = GENDER, path="figs/OTHER_Blocks", filename =paste0("GENDER_by_stimulus.png"), units = c("in"), width = 12, height = 12 , bg='#ffffff' )
ggsave(plot = ENCOUNTER, path="figs/OTHER_Blocks", filename =paste0("ENCOUNTER_by_stimulus.png"), units = c("in"), width = 12, height = 12 , bg='#ffffff' )
}SESSION
sessionInfo()## R version 4.3.2 (2023-10-31)
## Platform: x86_64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.7.2
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: America/New_York
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] emmeans_1.10.7 rstatix_0.7.2 kSamples_1.2-10 SuppDists_1.1-9.8
## [5] jmv_2.5.6 lmerTest_3.1-3 lme4_1.1-36 Matrix_1.6-5
## [9] sjPlot_2.8.17 see_0.11.0 report_0.6.1 parameters_0.24.2
## [13] performance_0.13.0 modelbased_0.10.0 insight_1.1.0 effectsize_1.0.0
## [17] datawizard_1.0.1 correlation_0.8.7 bayestestR_0.15.2 easystats_0.7.4
## [21] jtools_2.3.0 ggsankey_0.0.99999 tidygraph_1.3.1 interactions_1.2.0
## [25] paletteer_1.6.0 plotly_4.10.4 RColorBrewer_1.1-3 viridis_0.6.5
## [29] viridisLite_0.4.2 ggdist_3.3.2 patchwork_1.3.0 ggh4x_0.3.0
## [33] ggeasy_0.1.5 corrplot_0.95 GGally_2.2.1 gghalves_0.1.4
## [37] ggstatsplot_0.13.0 ggformula_0.12.0 ggridges_0.5.6 scales_1.3.0
## [41] qacBase_1.0.3 webshot2_0.1.1 tinytable_0.6.1 summarytools_1.1.1
## [45] magrittr_2.0.3 lubridate_1.9.4 forcats_1.0.0 stringr_1.5.1
## [49] dplyr_1.1.4 purrr_1.0.4 readr_2.1.5 tidyr_1.3.1
## [53] tibble_3.2.1 ggplot2_3.5.1 tidyverse_2.0.0 psych_2.4.12
## [57] Hmisc_5.2-2
##
## loaded via a namespace (and not attached):
## [1] splines_4.3.2 later_1.4.1 jmvcore_2.6.3
## [4] rpart_4.1.24 ggExtra_0.10.1 lifecycle_1.0.4
## [7] Rdpack_2.6.2 tcltk_4.3.2 globals_0.16.3
## [10] processx_3.8.6 lattice_0.22-6 MASS_7.3-60.0.1
## [13] backports_1.5.0 sass_0.4.9 rmarkdown_2.29
## [16] jquerylib_0.1.4 yaml_2.3.10 httpuv_1.6.15
## [19] minqa_1.2.8 chromote_0.4.0 abind_1.4-8
## [22] multcomp_1.4-28 nnet_7.3-20 TH.data_1.1-3
## [25] sandwich_3.1-1 labelled_2.14.0 pbkrtest_0.5.3
## [28] listenv_0.9.1 parallelly_1.42.0 codetools_0.2-20
## [31] tidyselect_1.2.1 ggeffects_2.2.1 farver_2.1.2
## [34] gmp_0.7-5 broom.mixed_0.2.9.6 matrixStats_1.5.0
## [37] base64enc_0.1-3 jsonlite_1.9.1 Formula_1.2-5
## [40] survival_3.8-3 systemfonts_1.1.0 BWStest_0.2.3
## [43] tools_4.3.2 ragg_1.3.3 pryr_0.1.6
## [46] PMCMRplus_1.9.12 Rcpp_1.0.14 glue_1.8.0
## [49] mnormt_2.1.1 gridExtra_2.3 xfun_0.51
## [52] distributional_0.5.0 websocket_1.4.2 numDeriv_2016.8-1.1
## [55] withr_3.0.2 fastmap_1.2.0 fansi_1.0.6
## [58] boot_1.3-31 digest_0.6.37 timechange_0.3.0
## [61] R6_2.6.1 mime_0.12 estimability_1.5.1
## [64] textshaping_1.0.0 colorspace_2.1-1 generics_0.1.3
## [67] data.table_1.17.0 httr_1.4.7 htmlwidgets_1.6.4
## [70] ggstats_0.9.0 pkgconfig_2.0.3 gtable_0.3.6
## [73] Rmpfr_1.0-0 statsExpressions_1.6.2 furrr_0.3.1
## [76] htmltools_0.5.8.1 carData_3.0-5 multcompView_0.1-10
## [79] snakecase_0.11.1 reformulas_0.4.0 knitr_1.49
## [82] rstudioapi_0.17.1 tzdb_0.4.0 reshape2_1.4.4
## [85] nloptr_2.2.0 coda_0.19-4.1 checkmate_2.3.2
## [88] nlme_3.1-167 ggcorrplot_0.1.4.1 cachem_1.1.0
## [91] zoo_1.8-13 sjlabelled_1.2.0 parallel_4.3.2
## [94] miniUI_0.1.1.1 foreign_0.8-88 pillar_1.10.1
## [97] grid_4.3.2 vctrs_0.6.5 promises_1.3.2
## [100] car_3.1-3 xtable_1.8-4 cluster_2.1.8.1
## [103] GPArotation_2024.3-1 htmlTable_2.4.3 evaluate_1.0.3
## [106] zeallot_0.1.0 magick_2.8.5 mvtnorm_1.3-3
## [109] cli_3.6.4 compiler_4.3.2 rlang_1.1.5
## [112] crayon_1.5.3 rstantools_2.4.0 labeling_0.4.3
## [115] rematch2_2.1.2 ps_1.9.0 sjmisc_2.8.10
## [118] plyr_1.8.9 stringi_1.8.4 pander_0.6.6
## [121] munsell_0.5.1 lazyeval_0.2.2 mosaicCore_0.9.4.0
## [124] sjstats_0.19.0 rapportools_1.2 hms_1.1.3
## [127] future_1.34.0 shiny_1.10.0 haven_2.5.4
## [130] rbibutils_2.3 igraph_2.1.4 broom_1.0.7
## [133] memoise_2.0.1 RcppParallel_5.1.10 bslib_0.9.0